home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / fresnel.src < prev    next >
Text File  |  1991-10-19  |  2KB  |  127 lines
  1. %%HP: T(3)A(R)F(.);
  2. @ FRESNEL by Nelson W. Wallace
  3. DIR
  4.   MAIN
  5.     \<< -40 CF 1 CF 2
  6. CF 3 CF RCLMENU
  7. 'MNU' STO CLLCD
  8. "MAIN N.Wallace 8/27/91
  9.  
  10.  Fresnel diffraction
  11. from an aperture, an
  12.  obstruction, or an
  13.        edge?"
  14. 1 DISP { { APERTURE
  15. } { } { OBSTRUCTION
  16. } { } { } { EDGE }
  17. } MENU -1 WAIT 'KB'
  18. STO CLLCD
  19.       IF 'KB\>=15.1'
  20.       THEN
  21. "edge input:" {
  22. ":s1min:
  23. :s1max:" {
  24. 1 0 } } INPUT OBJ\->
  25. DTAG SWAP DTAG SWAP
  26. XRNG 's1' INDEP 3
  27. SF
  28.       ELSE
  29. "aperture/obstr input"
  30. {
  31. ":\GDv:   
  32. :s0min: 
  33. :s0max: "
  34. { 1 0 } } INPUT
  35. OBJ\-> DTAG SWAP DTAG
  36. SWAP XRNG DTAG '\GDv'
  37. STO 's0' INDEP
  38.         IF 'KB\<=12.1
  39. '
  40.         THEN 1 SF
  41.         ELSE 2 SF
  42.         END
  43.       END CLLCD
  44.       IF 1 FS?
  45.       THEN
  46. 'GENERAL'
  47.       END
  48.       IF 2 FS?
  49.       THEN
  50. 'OBSTRUCTION'
  51.       END
  52.       IF 3 FS?
  53.       THEN 'EDGE'
  54.       END DUP \->STR
  55. 1 DISP 2 WAIT STEQ
  56. 'MNU' RCL MENU {
  57. MNU KB } PURGE -.1
  58. 3.3 YRNG ERASE DRAW
  59. 1 CF 2 CF 3 CF
  60.     \>>
  61.   GENERAL
  62.     \<<
  63. "Gen Fresnel Diffr."
  64. DROP RAD 's0-\GDv/2'
  65. EVAL 's1' STO 's0+
  66. \GDv/2' EVAL 's2' STO
  67. 'C(s2)-C(s1)+i*(S(
  68. s2)-S(s1))' EVAL
  69. ABS SQ
  70.     \>>
  71.   EDGE
  72.     \<<
  73. "Edge Fresnel Diffr."
  74. DROP RAD 'C(s1)+.5+
  75. i*(S(s1)+.5)' EVAL
  76. ABS SQ
  77.     \>>
  78.   OBSTRUCTION
  79.     \<<
  80. "Shadow Gen Fresnel Diffr."
  81. DROP RAD 's0-\GDv/2'
  82. EVAL 's1' STO 's0+
  83. \GDv/2' EVAL 's2' STO
  84. 'C(s2)-C(s1)+i*(S(
  85. s2)-S(s1))' EVAL '\v/
  86. 2*EXP(i*\pi/4)' EVAL
  87. SWAP - ABS SQ
  88.     \>>
  89.   S
  90.     \<< \-> v '\.S(0,v,
  91. SIN(\pi*t^2/2),t)'
  92. \->NUM
  93.     \>>
  94.   C
  95.     \<< \-> v '\.S(0,v,
  96. COS(\pi*t^2/2),t)'
  97. \->NUM
  98.     \>>
  99.   XiEQN
  100.     \<< 2 \Gl '1_mm'
  101. CONVERT r20 '1_mm'
  102. CONVERT * / \v/ X '1_
  103. mm' CONVERT * 'Xi'
  104. STO "Xi (or s)" Xi
  105.     \>>
  106.   X '.5_mm'
  107.   \Gl '.5_\Gm'
  108.   r20 '10_cm'
  109.   Xi 3.16227766017
  110.   \GDv 10.1
  111.   s0 1.9
  112.   s1 1.14999999974
  113.   s2 11.2499999997
  114.   t .01
  115.   v 8.2
  116.   CST { { APERTURE
  117. } { } { OBSTRUCTION
  118. } { } { } { EDGE }
  119. }
  120.   IERR
  121. 5.82143536203E-12
  122.   EQ GENERAL
  123.   PPAR { (0,-.1)
  124. (6.2,3.3) s0 0
  125. (0,0) FUNCTION Y }
  126. END
  127.